home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / DefDTIcon / ProcessMsg.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-11  |  7KB  |  261 lines
  1. Function UpperStr(S : String) : String;
  2. Var
  3.      X : Byte;
  4. Begin
  5.   For X := 1 To Length(S) Do
  6.     S[X] := UpCase(S[X]);
  7.   UpperStr := S;
  8. End;
  9.  
  10. Procedure HandleApp(AppPort : pMsgPort);
  11.  
  12.     
  13. VAR
  14.     mes         : pAppMessage;
  15.     strList     : pList;
  16.     WBarg       : pWBArg;
  17.     n           : byte;
  18.     RemKey      : pRemember;
  19.     node        : pStrNode;
  20.     FName       : STRPTR;
  21.     oldTT,oldDD,
  22.     oldTW,oldDT : Pointer;
  23.     olddir, dl1, 
  24.     dl2  : BPTR;
  25.     dobj,
  26.     defdobj     : pDiskObject;
  27.     OK          : Boolean;
  28.     dt          : pDataType;
  29.     BName, 
  30.     IName, 
  31.     ts, buf     : String;
  32.     existing    : Boolean;
  33.  
  34.     
  35. Procedure DoIt;
  36.  
  37. begin
  38.     oldTT := defdobj^.do_ToolTypes;
  39.     oldDD := defdobj^.do_DrawerData;
  40.     oldTW := defdobj^.do_ToolWindow; { dont know what it is !!}
  41.     oldDT := defdobj^.do_DefaultTool;
  42.     
  43.     if existing then begin
  44.         defdobj^.do_ToolTypes := dobj^.do_ToolTypes; 
  45.         defdobj^.do_DrawerData := dobj^.do_DrawerData;
  46.         defdobj^.do_StackSize := dobj^.do_StackSize;
  47.         { make this optional as I'm uncertian to what it will be ¿? }
  48.         If NOT V.NOTOOLWIN then
  49.             defdobj^.do_ToolWindow := dobj^.do_ToolWindow;
  50.         If NOT V.DEFAULTTOOL then
  51.             defdobj^.do_DefaultTool := dobj^.do_DefaultTool;
  52.         defdobj^.do_CurrentX := dobj^.do_CurrentX;
  53.         defdobj^.do_CurrentY := dobj^.do_CurrentY;
  54.     end else begin
  55.         defdobj^.do_CurrentX := NO_ICON_POSITION;
  56.         defdobj^.do_CurrentY := NO_ICON_POSITION;
  57.     end;
  58.     OK := PutDiskObject(FName,defdobj);
  59.     if NOT OK then 
  60.         OK := PutDiskObject(FName,dobj);
  61.                         
  62.     if existing then begin
  63.         defdobj^.do_ToolTypes := oldTT;
  64.         defdobj^.do_DrawerData := oldDD;
  65.         defdobj^.do_ToolWindow := oldTW;
  66.         defdobj^.do_DefaultTool := oldDT;
  67.     end;
  68.     FreeDiskObject(defdobj);
  69. end;
  70.  
  71. Function MakeFileName(iconname : String) : String;
  72.  
  73. Type
  74.     strin = String[255];
  75.     pStr = ^Strin;
  76.  
  77. Var
  78.     s : pStr;
  79.     
  80. Begin
  81.     MakeFileName := '';
  82.     iconname := 'def_'+iconname+#0;
  83.     s := AllocVec(256, MEMF_CLEAR);
  84.     if s <> NIL then begin
  85.         move(V.ICONDIR[1], s^, length(V.ICONDIR));
  86.         if AddPart(STRPTR(s), @iconname[1], 256) then
  87.             MakeFileName := PtrToPas(STRPTR(s));
  88.         FreeVec(s);
  89.     End;
  90. End;
  91.  
  92.  
  93.  
  94. Begin
  95.     OK := False;
  96.     mes := pAppMessage(GetMsg(AppPort));
  97.     RemKey := NIL;
  98.     While mes <> NIL do begin
  99.         if mes^.am_NumArgs > 0 then begin
  100.             StrList := AllocRemember(@RemKey, sizeof(tList), MEMF_CLEAR|MEMF_PUBLIC);
  101.             NewList(pList(StrList));
  102.             WBArg := mes^.am_ArgList;
  103.             For n := 0 to mes^.am_NumArgs-1 do begin
  104.             
  105.                 node := AllocRemember(@RemKey, sizeof(tStrNode), MEMF_CLEAR|MEMF_PUBLIC);
  106.                 if node <> NIL then begin
  107.                     node^.sn_Name := PtrToPas(STRPTR(WBArg^.wa_Name));
  108.                     node^.sn_Lock := dupLock(WBArg^.wa_Lock);
  109.                     AddTail(pList(StrList),pNode(node));
  110.                 End;
  111.                 WBArg := Pointer(Long(WBArg) + sizeof(tWBArg));
  112.             end;    
  113.         end else StrList := NIL;
  114.  
  115.         ReplyMsg(pMessage(mes));
  116.         
  117.         if StrList <> NIL then begin
  118.             node := pStrNode(StrList^.lh_Head);
  119.             While (Node^.sn_Node.ln_Succ <> NIL) do begin
  120.                 
  121.                 OK := False;
  122.                 if node^.sn_Name = '' then begin
  123.                     dl1 := ParentDir(node^.sn_Lock);
  124.                     if dl1 = NULL then begin
  125.                         { disk if NULL (root file system) parent }
  126.                         FName := CStrConstPtrAR(@RemKey,'disk');
  127.                     end else begin
  128.                         ok := NameFromLock(node^.sn_Lock, @ts, 256);
  129.                         unlock(node^.sn_Lock);
  130.                         node^.sn_Lock := dl1;
  131.                         FName := @ts;
  132.                     end;
  133.                 end else
  134.                     FName := CStrConstPtrAR(@RemKey,node^.sn_Name);
  135.  
  136.                 olddir := CurrentDir(node^.sn_Lock);
  137.  
  138.                 dl2 := lock(CStrConstPtrAR(@RemKey, PtrToPas(FName)+'.info'), SHARED_LOCK);
  139.                 if dl2 <> NULL then
  140.                     existing := True
  141.                 else
  142.                     existing := false;
  143.                 unlock(dl2);
  144.                 
  145.                 dobj := GetDiskObjectNew(FName);
  146.                 defdobj := NIL;
  147.                 
  148.                 if dobj <> NIL then begin
  149.                     if NOT((dobj^.do_Type = WBPROJECT) or (dobj^.do_Type = WBTOOL)) then begin
  150.                         if (dobj^.do_Type = WBDISK) or (dobj^.do_Type = WBDRAWER) or (dobj^.do_Type = WBKICK) then begin
  151.                             defdobj := GetDefDiskObject(dobj^.do_Type);
  152.                             if defdobj <> NIL then 
  153.                                 DoIt;
  154.                         End;
  155.                     end else begin
  156.                         if (DataTypesBase <> NIL) and (NOT V.NODATATYPE) then begin
  157.                             dl2 := Lock(FName, SHARED_LOCK);
  158.                             if dl2 <> NULL then begin
  159.                                 dt := ObtainDataTypeA(DTST_FILE, Pointer(dl2), NIL);
  160.                                 if dt <> NIL then begin
  161.                                 
  162.                                     if NOT V.COARSE then begin
  163.                                         if dt^.dtn_Header^.dth_ID = $62696E61 {bina} then
  164.                                             BName := 'Use sys tool'
  165.                                         else
  166.                                             BName := PtrToPas(dt^.dtn_Header^.dth_Name);
  167.                                     end else begin
  168.                                         if dt^.dtn_Header^.dth_ID = $62696E61 {bina} then
  169.                                             BName := 'Use sys tool'
  170.                                         else
  171.                                             BName := PtrToPas(IDToStr(dt^.dtn_Header^.dth_GroupID ,@buf));
  172.                                     end;
  173.                                 
  174.                                     if BName <> 'Use sys tool' then begin
  175.                                         IName := MakeFileName(BName);
  176.                                         defdobj := GetDiskObject(CStrConstPtrAR(@RemKey, IName));
  177.                                         if defdobj = NIL then begin
  178.                                             IName := MakeFileName(PtrToPas(dt^.dtn_Header^.dth_BaseName));
  179.                                             defdobj := GetDiskObject(CStrConstPtrAR(@RemKey, IName));
  180.                                             if defdobj = NIL then begin
  181.                                             IName := MakeFileName(PtrToPas(IDToStr(dt^.dtn_Header^.dth_GroupID ,@buf)));
  182.                                                 defdobj := GetDiskObject(CStrConstPtrAR(@RemKey, IName));
  183.                                                 if defdobj = NIL then
  184.                                                     defdobj := GetDefDiskObject(WBPROJECT);
  185.                                             end;
  186.                                         end;
  187.                                     end else begin
  188.                                         if NOT(V.NOTOOL) then
  189.                                             defdobj := GetDefDiskObject(WBTOOL)
  190.                                         else
  191.                                             defdobj := NIL;
  192.                                     End;
  193.                                     
  194.                                     if defdobj <> NIL then 
  195.                                         DoIt;
  196.                                     ReleaseDataType(dt);
  197.                                 end;
  198.                                 unlock(dl2);
  199.                             end;
  200.                         end else begin 
  201.                             defdobj := GetDefDiskObject(dobj^.do_Type);
  202.                             if defdobj <> NIL then 
  203.                                 DoIt;
  204.                         end;
  205.                     end;
  206.                 end;
  207.  
  208.                 if dobj <> NIL then
  209.                     FreeDiskObject(dobj);
  210.                         
  211.                 olddir := CurrentDir(olddir);
  212.                 unlock(node^.sn_Lock);
  213.                         
  214.                 If NOT OK then DisplayBeep(NIL);
  215.                 node := pStrNode(Node^.sn_Node.ln_Succ);
  216.             end;
  217.         end;
  218.         
  219.         {*********}
  220.         
  221.         mes := pAppMessage(GetMsg(AppPort));
  222.     end;
  223.     FreeRemember(@RemKey, True);
  224. end;
  225.  
  226.  
  227. Procedure ProcessMessage(VAR IDPort, AppPort : pMsgPort);
  228.  
  229. VAR 
  230.     Disable : Boolean;
  231.     IDSig, IDCMPSig, AppSig, sigrcvd, BitFlags : LONG;
  232.     Finished : Boolean;
  233.     mes : pMessage;
  234.     
  235. begin
  236.     IDSig := 0;
  237.     IDCMPSig := 0;
  238.     AppSig := 0;
  239.     disable := false;
  240.     finished := false;
  241.     
  242.     IDSig := 1 shl IDPort^.mp_SigBit;
  243.     AppSig := 1 shl AppPort^.mp_SigBit;
  244.     
  245.     BitFlags := SIGBREAKF_CTRL_C OR IDSig OR IDCMPSig OR AppSig;
  246.     While Not Finished do begin
  247.         sigrcvd := Wait(BitFlags);
  248.         if ((sigrcvd and IDSig)=IDSig) then begin
  249.             mes := GetMsg(IDPort);
  250.             ReplyMsg(mes);    
  251.             Finished := True;
  252.         end;
  253.         if ((sigrcvd and AppSig)=AppSig) then begin
  254.             HandleApp(AppPort);
  255.         end;
  256.         if ((sigrcvd and SIGBREAKF_CTRL_C)=SIGBREAKF_CTRL_C) then begin
  257.             Finished := True;
  258.         end; 
  259.     end;
  260. end;
  261.